module Fetcher
        ( defaultConnection
        , fetchLowChanges
        , fetchHighChanges
        , TableBar (..)
        , highChangeStatement
        , lowChangeStatement
        , Fetcher, fGetHigh, fGetLow, fGetBar
        , BaseFetcher (..)
        ) 
        where

import Control.Monad()
import Database.HDBC
import Database.HDBC.MySQL
import Data.Time
import Types

class Fetcher m where
        fGetHigh :: m->TableBar->Int->LocalTime->LocalTime->IO [(Double, Double)]
        fGetLow  :: m->TableBar->Int->LocalTime->LocalTime->IO [(Double, Double)]
        fGetBar  :: m->TableBar->Int->LocalTime->IO BarData

data IConnection m => BaseFetcher m = BaseFetcher {
        bfConn  :: m
        }

instance IConnection m => Fetcher (BaseFetcher m) where
        fGetHigh bf = fetchHighChanges (bfConn bf)
        fGetLow  bf = fetchLowChanges  (bfConn bf)
        fGetBar  bf = getForBar (bfConn bf)

prepareConnectionString :: String->String->String->MySQLConnectInfo
prepareConnectionString host user pwd = defaultMySQLConnectInfo {
                                mysqlDatabase = "pricer",
                                mysqlHost = host,
                                mysqlUser = user,
                                mysqlPassword = pwd
                              }
                              
defaultConnection = connectMySQL (prepareConnectionString "paulrz.dynalias.com" "pricer" "pricer")

data TableBar = HourBar | FourBar | DayBar| MinuteBar
        deriving (Show)

highChangeStatement :: IConnection conn => conn->TableBar->IO Statement
highChangeStatement c tbl = prepare c ("select  ROUND(HighPrice - OpenPrice, 4) as chng, count(1) as cnt \
        \from "++ (show tbl) ++" t \
        \where \
                \t.Symbol = ? \
                \and     t.Timestamp >= ? \
                \and   t.Timestamp <  ? \
                \group by chng")

lowChangeStatement :: IConnection conn => conn->TableBar->IO Statement
lowChangeStatement c tbl = prepare c ("select  ROUND(OpenPrice - LowPrice, 4) as chng, count(1) as cnt \
        \from "++ (show tbl) ++" t \
        \where \
                \t.Symbol = ? \
                \and     t.Timestamp >= ? \
                \and   t.Timestamp <  ? \
                \group by chng")

parseChange :: [SqlValue] -> (Double, Double)
parseChange [chng, cnt] = (fromSql chng, fromSql cnt)
parseChange _           = (0, 0)

fetchChangeByStmt stmt symbol fd td = do
        execute stmt [(toSql symbol), (toSql $ show fd), (toSql $ show td)]
        rows <- fetchAllRows' stmt
        return $ map parseChange rows

fetchLowChanges :: (IConnection c, Show t1) => c->TableBar->Int->t1->t1->IO [(Double, Double)]        
fetchLowChanges c tbl symbol fd td = do
        stmt <- lowChangeStatement c tbl
        execute stmt [(toSql symbol), (toSql $ show fd), (toSql $ show td)]
        rows <- fetchAllRows' stmt
        return $  map parseChange rows

fetchHighChanges :: (IConnection c, Show t1) => c->TableBar->Int->t1->t1->IO [(Double, Double)]
fetchHighChanges c tbl symbol fd td = do
        stmt <- highChangeStatement c tbl
        execute stmt [(toSql symbol), (toSql $ show fd), (toSql $ show td)]
        rows <- fetchAllRows' stmt
        return $ map parseChange rows

rangedStatement c = prepare c "select m.Timestamp, m.OpenPrice, m.HighPrice, m.LowPrice, m.ClosePrice, m.Volume \
        \ from MinuteBar m \
        \ join Ticker t on m.Symbol = t.Id \
        \ where \
               \ t.Name = ? \
        \ and   m.Timestamp >= ? \
        \ and   m.Timestamp < ? \
        \ order by m.Timestamp "

fakeUtcTime = UTCTime (ModifiedJulianDay 0) 0

parseRanged :: [SqlValue]->(UTCTime, BarData)
parseRanged [tstamp, o, h, l, c, v] = (fromSql tstamp, BarData (fromSql o) (fromSql h) (fromSql l) (fromSql c) (fromSql v))
parseRanged _ = (fakeUtcTime, BarData 0 0 0 0 0)

getRanged:: IConnection conn=>conn->String->String->String->IO [(UTCTime, BarData)]
getRanged c symbol fd td = do
        stmt <- rangedStatement c 
        execute stmt [(toSql symbol), (toSql fd), (toSql td)]
        rows <- fetchAllRows' stmt
        return $ map parseRanged rows

getForDay :: IConnection conn=> conn->String->Day->IO [(UTCTime, BarData)]                
getForDay c symbol day = do
        stmt <- rangedStatement c
        let tomorrow = succ day
        execute stmt [(toSql symbol), (toSql $ show day), (toSql $ show tomorrow)]
        rows <- fetchAllRows' stmt
        return $ map parseRanged rows
        
inbarStatement c tbl = prepare c ("select m.Timestamp, m.OpenPrice, m.HighPrice, m.LowPrice, m.ClosePrice, m.Volume \
        \ from "++(show tbl) ++" m \
        \ where \
               \ m.Symbol = ? \
        \ and   m.Timestamp = ?")

getForBar :: IConnection c => c->TableBar->Int->LocalTime->IO BarData
getForBar c tbl symbol day = do
        stmt <- inbarStatement c tbl
        execute stmt [(toSql symbol), (toSql $ show day)]
        rows <- fetchAllRows' stmt
        let (_, result) = if null rows then error ("No data for "++(show day)) else parseRanged (head rows)
        return result

insertDayBarStatement c = prepare c "insert into DayBar \
        \ (Symbol, `Timestamp`, OpenPrice, HighPrice, LowPrice, ClosePrice, Volume) \
        \ values (?, ?, ?, ?, ?, ?, ?) "
        
mapBarToSql symbol timestamp b = 
        [toSql symbol, toSql $ show timestamp, toSql $ barOpen b, toSql $ barHigh b, 
                toSql $ barLow b, toSql $ barClose b, toSql $ barVolume b]

insertDayBar c symbol day b = do
        stmt <- insertDayBarStatement c
        execute stmt $ mapBarToSql symbol day b
        
        
